home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
basic
/
apg_2.exe
/
PRINT.SKL
< prev
next >
Wrap
Text File
|
1993-03-16
|
5KB
|
232 lines
DEFINT A-Z
DECLARE SUB box ()
DECLARE SUB header ()
DECLARE SUB sortindex ()
XX DECLARE SUB total ()
XX DECLARE SUB subtotal ()
TYPE rectype 'Define variables for file
XX inbr AS STRING * 10
XX desc AS STRING * 30
XX ucost AS DOUBLE
XX lprice AS DOUBLE
XX group AS STRING * 7
sts AS STRING * 1
END TYPE
TYPE indextype 'Define index
recnum AS INTEGER
XX sort AS STRING * 37
END TYPE
DIM SHARED pline
DIM SHARED page
DIM SHARED numofrec
XX DIM SHARED f5.2$
XX DIM SHARED f6.2$
XX DIM SHARED f8.2$
XX DIM SHARED Tlprice#
XX DIM SHARED Slprice#
XX DIM SHARED item AS rectype
XX f5.2$ = "######.##"
XX f6.2$ = "#######.##"
XX f8.2$ = "#########.##"
ON ERROR GOTO errhandle
XX OPEN "ITEM.DAT" FOR RANDOM AS #1 LEN = LEN(item)
XX numofrec = LOF(1) \ LEN(item)
IF numofrec = 0 THEN
CLS
PRINT "You have to build the Data Base first."
INPUT "", a$
GOTO fina
END IF
DIM SHARED index(1 TO numofrec) AS indextype
FOR i = 1 TO numofrec
XX GET #1, i, item
index(i).recnum = i
XX index(i).sort = item.group + item.desc
NEXT i
COLOR , 1
CLS
COLOR 4, 1
LOCATE 1, 25
PRINT STRING$(30, 220)
LOCATE 2, 24
COLOR , 0
PRINT " ";
COLOR 0, 3
PRINT STRING$(30, " ")
XX LOCATE 2, 32
XX COLOR 0, 3: PRINT "PARTS COST LIST"
LOCATE 3, 24
COLOR , 0: PRINT STRING$(30, " ")
COLOR 7, 1
LOCATE 5, 26
PRINT "Date: "; DATE$; " "; TIME$
LOCATE 6, 26
XX PRINT "Program name: "; "itemprt"
LOCATE 7, 26
XX PRINT "Datafile name: "; "item.dat"
LOCATE 8, 26
PRINT "Number of records: "; numofrec
box
COLOR 0, 3
LOCATE 11, 26
PRINT "Please check to see that the"
LOCATE 12, 26
PRINT "printer has paper and is "
LOCATE 13, 26
PRINT "on-line. A)bort, or <ENTER>"
DO
a$ = INKEY$
LOOP WHILE a$ = ""
IF UCASE$(a$) = "A" GOTO fina
box
LOCATE 12, 27
PRINT "Sorting file - Please wait"
sortindex
box
first$ = "F"
FOR i = 1 TO numofrec
IF pline <= 0 THEN
IF first$ = "" THEN LPRINT CHR$(12)
header
END IF
XX GET #1, index(i).recnum, item
XX IF item.sts = "D" THEN GOTO nex
XX IF first$ = "" THEN
XX IF (item.group) <> group$ THEN
XX subtotal
XX Slprice# = 0
XX END IF
XX END IF
XX LPRINT TAB(2); item.inbr;
XX LPRINT TAB(14); item.group;
XX LPRINT TAB(23); item.desc;
XX LPRINT USING f6.2$; TAB(57); item.lprice;
XX LPRINT USING f5.2$; TAB(69); item.ucost
a$ = INKEY$
IF a$ = CHR$(27) THEN GOTO fin
first$ = ""
pline = pline - 1
XX Tlprice# = Tlprice# + item.lprice
XX Slprice# = Slprice# + item.lprice
XX group$ = item.group
nex:
NEXT i
XX subtotal
XX total
fin:
XX LPRINT CHR$(18); 'Reset from condensed
LPRINT CHR$(12); 'Form Feed
fina:
COLOR 7, 1
CLS
CLOSE
XX RUN "zmenu"
END
errhandle:
IF ERR = 25 THEN
box
LOCATE 12, 32
PRINT "Printer Not ready"
LOCATE 13, 32
PRINT "Abort or Retry "
DO
a$ = INKEY$
LOOP WHILE a$ = ""
IF UCASE$(a$) = "R" THEN
box
LOCATE 12, 32
PRINT "Printing Page:"; page
LOCATE 13, 32
PRINT "<Escape> to cancel"
RESUME
ELSE
GOTO fina
END IF
ELSE
CLS
PRINT "Unexpected error number"; ERR
PRINT "Please consult your Quickbasic Manual"
INPUT "", a$
GOTO fina
END IF
SUB box
COLOR 4, 1
LOCATE 10, 25
PRINT STRING$(30, 220)
COLOR 9, 7
LOCATE 11, 24
COLOR 0: PRINT CHR$(219); : COLOR , 3: PRINT STRING$(30, " ")'219)
LOCATE 12, 24
COLOR 0: PRINT CHR$(219); : COLOR , 3: PRINT STRING$(30, " ")'219)
LOCATE 13, 24
COLOR 0: PRINT CHR$(219); : COLOR , 3: PRINT STRING$(30, " ")'219)
LOCATE 14, 24
COLOR 0: PRINT STRING$(30, 219)
END SUB
SUB header
first$ = ""
page = page + 1
LOCATE 12, 32
PRINT "Printing Page:"; page
LOCATE 13, 31
PRINT "<Escape> to cancel"
IF first$ = "" THEN
XX IF pagecol = 132 THEN LPRINT CHR$(27); CHR$(15);
XX width lprint 132
first$ = "F"
END IF
LPRINT TAB(2); "Run date: "; DATE$; " "; TIME$;
XX LPRINT TAB(70); "Page:"; page
XX LPRINT TAB(2); "Program Name: ITEMPRT";
XX LPRINT TAB(35); "ITEM MASTER"
LPRINT ""
XX LPRINT TAB(2); "ITEM";
XX LPRINT TAB(14); "GROUP";
XX LPRINT TAB(23); "DESCRIPTION";
XX LPRINT TAB(55); "LIST";
XX LPRINT TAB(69); "UNIT COST"
XX LPRINT TAB(2); "NUMBER";
XX LPRINT TAB(55); "PRICE";
XX LPRINT STRING$(80, "=")
pline = 51
END SUB
SUB sortindex STATIC
SHARED index() AS indextype, numofrec
offset = numofrec \ 2
DO WHILE offset > 0
limit = numofrec - offset
DO
switch = FALSE
FOR i = 1 TO limit
IF UCASE$(index(i).sort) > UCASE$(index(i + offset).sort) THEN
SWAP index(i), index(i + offset)
switch = i
END IF
NEXT i
limit = switch
LOOP WHILE switch
offset = offset \ 2
LOOP
END SUB